Metodología General

Para poder aplicar masivamente los algoritmos, pretendimos lograr un esquema similar al que propone R con la función lm.

Todos los modelos disponen de una función que, más allá de los vericuetos específicos a cada método, es capaz de tomar una tabla de datos adecuada y una formula (similar a la llamada lm(y~x_1,x_2 ... , datos) ), y entrenar una función de clasificación capaz de tomar como argumento una nueva tabla con más datos.

Por ser significativa la cantidad de código requerida por cada función, esta vez organizamos todo el TP como un proyecto de mayor envergadura y separamos el código puro en una carpeta R. En la carpeta vignettes hay tres archivos importantes: un guión de lectura y organización de la tabla de datos, otro que realiza y tabula las clasificaciones según todos los modelos y este archivo de informe.

Todas las funciones están diseñadas para tomar formulas multivariadas, con las predicciones sobre una sola variable como caso particular.

El indicador de eficiencia que elegimos en esta ocasión es la tasa de acierto promedio durante la evaluación en k pliegues (trabajamos con \(k=10\)), que en la tabla se llama tasa pesada.

Decidimos que dado que no se va a llevar ningún proceso de decisión posterior con los modelos entrenados y seleccionados, no necesitamos reevaluar el rendimiento de los mismos con una tercera partición de validación y en lugar de eso volcamos la mayor cantidad posible de datos al entrenamiento de las funciones. Lo que nos interesa es el rendimiento relativo. Presentamos la tabla con la salida de la evaluación general, ordenada según la tasa de acierto promedio por pliegue antes de reflexionar sobre cada algoritmo por separado.

kable( head ( tabla_resultados )  )

Dado que el algoritmo k vecinos más cercanos (kvmc) acapara la tabla, la reelaboramos para mostrar los dos mejores resultados en cada algoritmo:

El Conjunto de Datos

Disponemos de casi 4.200 observaciones de abulones sobre 10 variables, de las cuales una es la clasificación entre adulto o no adulto y nueve son potenciales predictores.

Si bien la tabla tiene 10 dimensiones, elegimos dos variables por modelo como ejes para mostrar una representación gráfica del conjunto a estudiar según cada fórmula. Más tarde, vamos a ir sobreimponiendo las diversas “caligrafías” de las funciones de clasificación de dos variables para ver cómo cada algoritmo interpreta la frontera.

Como se puede ver (más adelante vamos a proyectar sobre los pares de ejes más relevantes para cada algoritmo) los datos están profundamente imbricados y además los que podríamos considerar atípicos (puntos de un color, escondidos profundamente en la nube de la categoría opuesta) no forman cúmulos si no que están dispersos. Esto ya nos indica que ninguno de los métodos que vamos a considerar va a tener una eficiencia cercana al 100%, pero vamos a ver cuánto se alejan del predictor trivial.

pi_adulto  <-  nrow (abalone %>% filter(adulto==T) ) / nrow(abalone)

Regresión Logística:

Para implementar este algoritmo, fue necesario resolver varios problemas:

• Para parametrizar el modelo se requiere una función de descenso por el gradiente (dg, en el archivo rlog.R).

• La función de penalización (maximización) asociada es la logverosimilitud, que también fue implementada junto a su gradiente para poder aplicar el proceso de maximización.

• Dado que esta función nos devuelve en realidad las probabilidades de pertenecer a la clase asociada con el valor 1, es posible implementar también la curva ROC.

  Si bien el manual no hace énfasis en la posibilidad de emplear la regresión logística sobre modelos con más de un predictor, en clase vimos el caso general para n predictores y por esta razón decidimos implementarlo con este grado de generalidad. Debido a la necesidad de parametrizar con un descenso por el gradiente, este modelo es computacionalmente costoso de entrenar. La función predictora obtenida, sin embargo, es eficiente.

kable(head(tabla_rlog))

grilla_log <- rlog_area(adulto~anillos+peso.viscera, abalone, rlog) 

abalone %>%
  ggplot(data = abalone, mapping = aes(x=anillos, y=peso.viscera, color = adulto)) +
  geom_jitter() +
  geom_smooth(data = grilla_log, mapping = aes(x=anillos, y=peso.viscera), inherit.aes = F)   

## `geom_smooth()` using method = 'loess'

Análisis por Discriminantes

La implementación de estas funciones es bastante más sencilla. Dado que estos algoritmos dependen de las diferentes medias y (en el caso cuadrático) desvios propios de cada categoría, no es necesario ni posible realizar un escalado y por lo tanto llamar un descenso por el gradiente para parametrizar sobre la fórmula empleada no es trivial. Por esta razón, no introdujimos coeficientes para optimizar con un descenso por el gradiente como en la regresión logística. Este trabajo tampoco hubiera sido muy útil porque es mejor emplear componentes principales para lograr un efecto similar (tomar predictores que nos den el mayor efecto posible sobre la precisión del modelo). Para ambos modelos de la familia se obtuvo una eficiencia muy alta a nivel computacional, tanto en el entrenamiento como en la clasificación. Para ver el comportamiento, elegimos las dos variables que definieron el modelo más explicativo. Tanto en este algoritmo como en el siguiente (análisis por discriminante cuadrático) esta fórmula es adulto ~ anillos + peso.viscera:

kable(head(tabla_adl))

grilla_adl <- trazar_area(adulto~peso.viscera+anillos, abalone, generar_el_predictor_adl) 

abalone %>%
  ggplot(data = abalone, mapping = aes(x=anillos, y=peso.viscera, color = adulto)) +
  geom_jitter() +
  geom_smooth(data = grilla_adl, mapping = aes(x=anillos, y=peso.viscera), inherit.aes = F)   

## `geom_smooth()` using method = 'loess'

kable(head(tabla_adc))

grilla_adc <- trazar_area(adulto~peso.viscera+anillos, abalone, generar_el_predictor_adc) 

abalone %>%
  ggplot(data = abalone, mapping = aes(x=anillos, y=peso.viscera, color = adulto)) +
  geom_jitter() +
  geom_smooth(data = grilla_adc, mapping = aes(x=anillos, y=peso.viscera), inherit.aes = F)   

## `geom_smooth()` using method = 'loess'

Análisis por los K Vecinos Más Cercanos

kable(head(tabla_kvmc))

grilla_kvmc <- trazar_area(adulto~peso.desenvainado+anillos, abalone, generar_k_vecinos_con_k_optimo) 

## [1] "KVCM trabajando con K = 45"

abalone %>%
  ggplot(data = abalone, mapping = aes(x=anillos, y=peso.desenvainado, color= adulto)) +
  geom_jitter() +
  geom_smooth(data = grilla_kvmc, mapping = aes( x = anillos, y = peso.desenvainado), inherit.aes = F)   

## `geom_smooth()` using method = 'loess'